home *** CD-ROM | disk | FTP | other *** search
/ Mac Cube 4: Multimedia Applications / MacCube Volume 4: Multimedia Applications.iso / Graphics / NIH Image Folder / Macros / Demo Macro < prev    next >
Text File  |  1993-06-08  |  6KB  |  339 lines
  1. procedure AdvanceRoi;
  2. begin
  3.   hloc:=hloc+RoiWidth;
  4.   if (hloc+RoiWidth div 2)>PicWidth then begin
  5.     hloc:=0;
  6.     vloc:=vloc+RoiHeight;
  7.   end;
  8.   if (hloc+RoiWidth)>PicWidth then hloc:=PicWidth-RoiWidth;
  9.   if (vloc+RoiHeight)>PicHeight then vloc:=PicHeight-RoiHeight;
  10.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  11. end;
  12.  
  13.  
  14. procedure MakeBlocks(n:integer);
  15. var
  16.   i,hloc,vloc,PicWidth,PicHeight:integer;
  17.   RoiWidth,RoiHeight:integer;
  18.   scale:real;
  19. begin
  20.   GetPicSize(PicWidth,PicHeight);
  21.   scale:=1/n;
  22.   SelectAll;
  23.   SetScaling('Nearest Neighbor; Same Window');
  24.   ScaleAndRotate(scale,scale,0);
  25.   RestoreRoi;
  26.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  27.   copy;
  28.   SelectAll;
  29.   Clear;
  30.   hloc:=0;
  31.   vloc:=0;
  32.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  33.   for i:=1 to n*n do begin
  34.     Paste;
  35.     AdvanceRoi;
  36.   end;
  37.   KillRoi;
  38. end;
  39.  
  40.  
  41. procedure DoTextDemo;
  42. begin
  43.   RevertToSaved;
  44.   MoveTo(100,20);
  45.   SetForegroundColor(255);
  46.   SetBackgroundColor(0);
  47.   SetFont('Geneva');
  48.   SetFontSize(24);
  49.   SetText('No background, Bold, Center');
  50.   Writeln('Text');
  51.   SetText('With background');
  52.   Writeln('With Background');
  53.   SetText('Bold');
  54.   Writeln('Bold');
  55.   SetText('Underlined');
  56.   Writeln('Underlined');
  57.   SetText('Italic');
  58.   Writeln('Italics');
  59.   SetText('Outline');
  60.   Writeln('Outlined');
  61.   SetText('Shadow');
  62.   Writeln('Shadowed');
  63.   SetText('Plain');
  64.   SetFontSize(9);
  65.   MoveTo(100,240);
  66.   Writeln('Very small');
  67.   wait(.5);
  68.   SetFontSize(24);
  69.   MoveTo(100,240);
  70.   Writeln('Small')
  71.   wait(.5);
  72.   SetFontSize(48);
  73.   MoveTo(100,240);
  74.   SetText('Bold');
  75.   Writeln('MEDIAN')
  76.   wait(.5);
  77.   SetFontSize(96);
  78.   MoveTo(100,240);
  79.   Writeln('LARGE')
  80.   wait(1);
  81. end;
  82.  
  83.  
  84. procedure DrawGrayLevelScale(nBoxes:integer);
  85. var
  86.   PicWidth, PicHeight,i,GrayLevel,hloc,vloc,width,height,vdelta:integer;
  87. begin
  88.   GetPicSize(PicWidth,PicHeight);
  89.   SetFont('Helvetica');
  90.   SetFontSize(9);
  91.   SetText('Bold; Center; with background');
  92.   SetBackgroundColor(0);
  93.   width:=0.9*PicHeight/nBoxes;
  94.   height:=width;
  95.   hloc:=0.05*PicHeight
  96.   vloc:=hloc;
  97.   vdelta:=height-1;
  98.   GrayLevel:=0;
  99.   for i:=1 to nBoxes do begin
  100.     MakeRoi(hloc,vloc,width,height);
  101.     SetForeground(GrayLevel);
  102.     Fill;
  103.     SetForeground(255);
  104.     DrawBoundary;
  105.     MoveTo(hloc+width/2,vloc+height/2);
  106.     Writeln(GrayLevel);
  107.     GrayLevel:=GrayLevel+trunc(256/nBoxes);
  108.     vloc:=vloc+vdelta;
  109.   end;
  110. end;
  111.  
  112.  
  113. procedure DrawColorScale;
  114. var
  115.   top,left,width,height,nLabels,i,tvloc:integer;
  116. begin
  117.   nLabels:=16;
  118.   SetFontSize(12);
  119.   SetFont('Helvetica');
  120.   SetText('Right Justified');
  121.   DrawScale;
  122.   GetRoi(left,top,width,height);
  123.   KillRoi;
  124.   SetForeground(255); {black}
  125.   SetBackground(0); {255}
  126.   vloc:=top;for i:=1 to nLabels do begin
  127.     MoveTo(left+width+25,vloc+3);
  128.     tvloc:=vloc;
  129.     if tvloc>(top+height-1) then tvloc:=Top+height-1;
  130.     Writeln(GetPixel(left,tvloc));
  131.     vloc:=vloc+round(height/(nLabels-1));
  132.   end; 
  133. end;
  134.  
  135.  
  136. procedure DoColorScaleDemo;
  137. var
  138.   PicWidth,PicHeight,hloc,vloc,ScaleWidth,ScaleHeight:integer;
  139. begin
  140.   GetPicSize(PicWidth,PicHeight);
  141.   width:=0.1*PicWidth;
  142.   if width>40 then width:=40;
  143.   height:=0.9*PicHeight;
  144.   hloc:=0.05*PicHeight
  145.   vloc:=hloc;
  146.   SetPalette('Spectrum');
  147.   MakeRoi(hloc,vloc,width,height);
  148.   DrawColorScale;
  149.   wait(2);
  150.   SetPalette('Grayscale');
  151. end;
  152.  
  153.  
  154. procedure DemoFilters;
  155. var
  156.   hloc,vloc,RoiWidth,RoiHeight,PicWidth,PicHeight:integer;
  157. begin
  158.   MakeBlocks(3);
  159.   RestoreRoi;
  160.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  161.   GetPicSize(PicWidth,PicHeight);
  162.   hloc:=0; vloc:=0;
  163.   AdvanceRoi;
  164.   SetOption; Sharpen;
  165.   AdvanceRoi;
  166.   Shadow;
  167.   AdvanceRoi;
  168.   TraceEdges;
  169.   AdvanceRoi;
  170.   SetOption; Smooth;
  171.   TraceEdges;
  172.   Skeletonize;
  173.   AdvanceRoi;
  174.   Dither;
  175.   AdvanceRoi;
  176.   Invert;
  177.   AdvanceRoi;
  178.   FlipVertical;
  179.   AdvanceRoi;
  180.   FlipHorizontal;
  181. end;
  182.  
  183.  
  184. procedure MakeGrayLevelGrid;
  185. var
  186.   i,hloc,vloc,PicWidth,PicHeight:integer;
  187.   RoiWidth,RoiHeight,GrayLevel,increment:integer;
  188.   scale:real;
  189. begin
  190.   n:=5;
  191.   GetPicSize(PicWidth,PicHeight);
  192.   hloc:=0;
  193.   vloc:=0;
  194.   RoiWidth:=PicWidth div n;
  195.   RoiHeight:=PicHeight div n;
  196.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  197.   GrayLevel:=255;
  198.   increment:=round(256/(n*n));
  199.   SetLineWidth(1);
  200.   for i:=1 to n*n do begin
  201.     SetForeground(GrayLevel);
  202.     fill;
  203.     SetForeground(0);
  204.     DrawBoundary;
  205.     GrayLevel:=GrayLevel-increment;
  206.     if GrayLevel<0 then GrayLevel:=0;
  207.     AdvanceRoi;
  208.   end;
  209.   KillRoi;
  210. end;
  211.  
  212.  
  213. macro 'Demo Macro [D]'
  214. {
  215. This macro demonstrate many of the features available in Image's macro
  216. language. It assumes the Image at least as large as`256x256 has been opened.
  217. }
  218. var
  219.   i:integer;
  220.   width,height,n,W,H:integer;
  221.   scale:real;
  222.   NoImage:boolean;
  223. begin
  224.   NoImage:=nPics<>1;
  225.   if not NoImage then GetPicSize(width,height);
  226.   if NoImage or (width<256) or (height<256) then begin
  227.     PutMessage('This macro needs a single image at least 256 pixels wide and 256 pixels high  to operate on.');
  228.     Exit;
  229.   end;
  230.  
  231.   SaveState;
  232.   DemoFilters;
  233.   wait(2);
  234.  
  235.   RevertToSaved;
  236.   MakeGrayLevelGrid;
  237.   wait(1);
  238.  
  239.   RevertToSaved;
  240.   DrawGrayLevelScale(12);
  241.   wait(1);
  242.  
  243.   RevertToSaved;
  244.   DoColorScaleDemo;
  245.  
  246.   DoTextDemo;
  247.  
  248.  
  249.   RevertToSaved;
  250.   SetScaling('Nearest Neighbor; Same Window');
  251.   for i:= 1 to 4 do begin
  252.     ScaleAndRotate(1.5,1.5,0);
  253.     wait(.5);
  254.   end;
  255.  
  256.   RevertToSaved;
  257.   for i:=1 to 6 do begin
  258.     ScaleAndRotate(0.6,0.6,0);
  259.     wait(.5);
  260.     RestoreRoi;
  261.   end;
  262.  
  263.   RevertToSaved;
  264.   wait(.5)
  265.   ScaleAndRotate(.333,1,0);
  266.   wait(1);
  267.   Undo;
  268.   ScaleAndRotate(1,.333,0);
  269.   wait(1);
  270.  
  271.   Undo;;
  272.   FlipVertical;
  273.   wait(.5);
  274.   Undo;
  275.   FlipHorizontal;
  276.   wait(.5);
  277.   Undo;
  278.   RotateRight(true);
  279.   RotateLeft(true);
  280.  
  281.   Shadow;
  282.   Wait(1);
  283.  
  284.   Undo;
  285.   Duplicate('Temp');
  286.   Smooth;
  287.   for i:=1 to 3 do begin SetOption; Sharpen end;
  288.   wait(.5);
  289.   Dispose;
  290.   SelectPic(1);
  291.   Dither;
  292.   wait(.5);
  293.  
  294.   Undo;
  295.   AddConstant(100);
  296.   Wait(1);
  297.   Undo;
  298.   AddConstant(-100);
  299.   Wait(1);
  300.   EnhanceContrast;
  301.   Wait(.5);
  302.   Undo;
  303.   EqualizeHistogram;
  304.   Wait(.5);
  305.   ResetGraymap;
  306.   ShowHistogram;
  307.  
  308.   Smooth;
  309.   TraceEdges;
  310.   wait(.5);
  311.   Erode;
  312.   Dilate;
  313.   Outline;
  314.   Undo;
  315.   Skeletonize;
  316.   Wait(1);
  317.   for i:= 1 to 12 do TraceEdges;
  318.   RestoreState;
  319. end;
  320.  
  321.  
  322. macro 'Make Wallpaper… [M]'
  323. var
  324.   width,height,n:integer;
  325. begin
  326.   GetPicSize(width,height);
  327.   if (width=0) then begin
  328.     PutMessage('This macro needs an image to operate on.');
  329.     Exit;
  330.   end;
  331.   n:=trunc(GetNumber('Replication factor:',8));
  332.   SaveState;
  333.   MakeBlocks(n);
  334.   RestoreState;
  335. end;
  336.  
  337.  
  338.  
  339.